home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / LIFE.4TH < prev    next >
Text File  |  1994-10-30  |  4KB  |  158 lines
  1. \ Conway's game of Life
  2. \ Copyright (C) 1985 by Thomas Almy.  All rights reserved.
  3. \  Users of ForthCMP are given permission to use or distribute this
  4. \  program, as long as no charge is made and the credit message is maintained.
  5.  
  6.  
  7. \  For IBM PC or clones with CGA, EGA, VGA, or XGA only.
  8.  
  9. \  Say "LIFE" to run with contents of screen.
  10. \  Say "LIFE X" to do example.
  11.  
  12. \  Peformance has been enhanced with code words in two places
  13.  
  14.  
  15. 100 MSDOS
  16. ," Copyright (C) 1985 by Thomas Almy.  All rights reserved."
  17.  
  18. \ DATA DEFINITIONS
  19. 80 CONSTANT C/L        \ characters per line
  20. 25 VALUE L/P        \ lines per "page"
  21. 50 CONSTANT MAXL/P    \ maximum L/P value
  22. 0 VALUE C/P        \ characters per page
  23. 0 VALUE CRTSTART    \ offset of display start
  24.  
  25. 0 , ( fill )
  26. CREATE BUFF1  C/L  MAXL/P CELL+ *  ALLOT    \ pair of generation bufs
  27. 0 , ( fill )
  28. CREATE BUFF2  C/L  MAXL/P CELL+ *  ALLOT
  29. 0 , ( fill )
  30.  
  31. VARIABLE FRBUF  BUFF1 FRBUF !        \ pointers to buffers
  32. VARIABLE TOBUF  BUFF2 TOBUF !
  33.  
  34. 2       CONSTANT ONCHAR            \ Smiley face is lifeform
  35. 0       CONSTANT OFFCHAR
  36. OFFCHAR 9 * ONCHAR OFFCHAR - 3 * + CONSTANT 3ON
  37. OFFCHAR 9 * ONCHAR OFFCHAR - 4 * + CONSTANT 4ON
  38.  
  39. \ Create Example Lifeform
  40.  
  41. 2 1 IN/OUT  ( INSERT is the inverse operation of COUNT )
  42. : INSERT   ( buffer char -- buffer+1 )
  43.     OVER C! 1+ ;
  44.  
  45. 2 1 IN/OUT
  46. : MTLINES     ( buffer quantity -- buffer+quantity )
  47.     C/L * 0 DO OFFCHAR INSERT LOOP ;
  48.  
  49. 1 0 IN/OUT
  50. : EXAMPLE> ( bufaddr -- )
  51.     ( WE WILL FAKE IT FOR NOW )
  52.     L/P 2/ MTLINES
  53.     25 0 DO OFFCHAR INSERT LOOP
  54.     5 0 DO  5 0 DO ONCHAR INSERT LOOP OFFCHAR INSERT LOOP
  55.     25 0 DO OFFCHAR INSERT LOOP
  56.     L/P 2/ 13 - 2 + MTLINES
  57.     DROP
  58. ;
  59.  
  60.  
  61. \ EXTRACT FROM DISPLAY  -- MACHINE DEPENDENT
  62. HEX
  63. B800 CONSTANT SCREEN ( screen segment )
  64. DECIMAL
  65. 1 0 IN/OUT
  66. : DISPLAY>  ( buffer -- )
  67.     1 MTLINES
  68.     C/P 0 
  69.     DO  SCREEN  I CELLS CRTSTART + C@L  BL = IF OFFCHAR ELSE ONCHAR THEN INSERT  LOOP
  70.     1 MTLINES  DROP ;
  71.  
  72.  
  73. \ SEND TO DISPLAY -- MACHINE DEPENDENT
  74. 0 0 IN/OUT
  75. : INIT-DISPLAY  
  76.     C/P 2 * CRTSTART + 9 CRTSTART +
  77.     DO 12 SCREEN I C!L 2 +LOOP ;
  78.  
  79. VARIABLE GEN#
  80. 0 0 IN/OUT
  81. : SHOW-GENERATION  ( -- )
  82.     ?DS:  GEN# @ 0 
  83.         <#  
  84.         7 HOLD  
  85.         #
  86.                  3 0 DO 7 HOLD 2DUP OR IF # ELSE BL HOLD THEN LOOP 
  87.         #> 
  88.     DROP SCREEN CRTSTART 8 CMOVEL
  89.     1 GEN# +! ;
  90.  
  91. 1 0 IN/OUT
  92. CODE FILL-DISPLAY ( addr - AX )
  93.     AX SI MOV ' C/P [] CX MOV
  94.     ' CRTSTART [] DI MOV  SCREEN # AX MOV  AX ES >SEG  CLD
  95.     BEGIN,  BYTE LODS  BYTE STOS  DI INC  LOOP ~ UNTIL,
  96.     RET  END-CODE
  97.  
  98. 1 0 IN/OUT
  99. : >DISPLAY  ( buffer -- )
  100.     C/L +  FILL-DISPLAY  
  101.     SHOW-GENERATION ;
  102.  
  103.  
  104. \ Process at a coordinate
  105. 2 1 IN/OUT
  106. CODE PROCESS-CHAR  ( AX - source BX - dest --- AX - dest+1 )
  107.     AX SI MOV 
  108.     [SI] AX MOV 
  109.     C/L +[SI] AX ADD
  110.     C/L NEGATE +[SI] AX ADD  
  111.     AH AL ADD
  112.     -1 +[SI] AL ADD
  113.     C/L 1- +[SI] AL ADD
  114.     C/L 1+ NEGATE +[SI] AL ADD
  115.     3ON # AL CMP <0 IF, AL AL XOR ELSE,
  116.         =0 IF, ONCHAR # AL MOV  ELSE,
  117.             4ON # AL CMP =0 IF, [SI] AL MOV ELSE,
  118.             AL AL XOR    
  119.     THEN, THEN, THEN,
  120.     AL [BX] MOV 
  121.     BX INC  
  122.     BX AX MOV RET
  123.     END-CODE
  124.  
  125. \ Process a screenfull
  126. 0 0 IN/OUT
  127. : PROCESS-SCREEN ( -- )
  128.     TOBUF @  C/L +  FRBUF @  C/L +
  129.     DUP C/P + SWAP DO  I PROCESS-CHAR  LOOP DROP ;
  130.  
  131. 1 0 IN/OUT
  132. : SWAP-T/B  ( this makes display wrap in all directions! )
  133.     DUP C/L + DUP C/P + C/L CMOVE
  134.     DUP C/P + SWAP C/L CMOVE ;
  135.  
  136.  
  137. \ Main program
  138. : MAIN  
  139.     [HEX] 
  140.     40 84 C@L ?DUP IF 1+ MAXL/P MIN  TO L/P THEN
  141.     40 4E @L TO CRTSTART    \ offset of display start
  142.     [DECIMAL]
  143.     C/L L/P * TO C/P
  144.     FRBUF @ 128 C@ IF EXAMPLE> ELSE DISPLAY> THEN
  145.     INIT-DISPLAY
  146.     TOBUF @ C/L L/P CELL+ * OFFCHAR FILL
  147.     FRBUF @ >DISPLAY
  148.     BEGIN
  149.         FRBUF @ SWAP-T/B
  150.         PROCESS-SCREEN TOBUF @ >DISPLAY
  151.         FRBUF @ TOBUF @ FRBUF ! TOBUF !
  152.         KEY?
  153.     UNTIL ;
  154.  
  155. INCLUDE FORTHLIB
  156. END
  157.  
  158.